Sims

path_proj = here::here()
path_source = file.path(path_proj, "source")

# source(file.path(path_source, "simulation", "simulations_functions.R"))
source(file.path(path_source, "simulation", "simulations_functions_final.R"))

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:reshape2':
## 
##     smiths

source(file.path(path_source, "functions", "plot_function.R"))

## 
## Attaching package: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

source(file.path(path_source, "functions", "fit_function.R"))
source(file.path(path_source, "functions", "table_function.R"))

#models
fixed_q <- file.path(path_proj, "source", "models",
                     "trunc", "1.stan_model_fixed_q_trunc.stan")
fixed_b <- file.path(path_proj, "source", "models",
                     "trunc", "2.stan_model_fixed_b_trunc.stan")
linear_b <- file.path(path_proj, "source", "models", "trunc",
                     "3.stan_model_linear_b_trunc.stan")
# ou_b <- file.path(path_proj, "source", "models", "trunc",
#                      "4.stan_model_ou_b_trunc.stan")

ou_b <-  file.path(path_proj, "source", "models", "trunc",
                      "4.stan_model_ou_b_trunc.stan")

compiled_models <- list(
  fixed_q = cmdstan_model(fixed_q),
  fixed_b = cmdstan_model(fixed_b),
  linear_b = cmdstan_model(linear_b),
  ou_b = cmdstan_model(ou_b)
)

simulate data

settings and data

###### setting #####
seed <- 123
set.seed(seed)
# data
alpha_increase_seq_1 <- seq(10, 750, by = 30)
alpha_decrease_seq_1 <- seq(750, 10, by = -30)
alpha_lamb =  c( rep(10,5), alpha_increase_seq_1 + rnorm(alpha_increase_seq_1,10,10), 
                 alpha_decrease_seq_1 + rnorm(alpha_decrease_seq_1,10,10),
                 rep(10,5))
beta_lamb = 0.5
n_obs = 60
# reprot structure
D <- 10; D_complete <- 20; if_fully_reported <- T
# model
method = "ou"; 
alpha_ou=0.4; mu_ou=0.4; b_init=0.4; 
# sd changes for each scenario
sigma_ou_1 = 0.01; sigma_ou_2 = 0.1; sigma_ou_3 = 0.3

# input list
params_1 <- list(
  data = list(
    alpha_lamb = alpha_lamb,  
    beta_lamb  = beta_lamb,
    n_obs       = n_obs,
    date_start = as.Date("2024-01-01"),
    seed       = seed
  ),
  reporting = list(
    D           = D,     
    D_complete        = D_complete,    
    if_fully_reported = if_fully_reported
  ),
  q_model = list(
    method        = method,
    method_params = list(alpha = alpha_ou, mu = mu_ou, 
                         b_init = b_init, sigma_ou = sigma_ou_1)
  )
)
# date that we run
#scoreRange <- seq(as.Date("2024-01-15"),as.Date("2024-02-29"),by="14 day")
scoreRange <- c(as.Date("2024-01-29"),as.Date("2024-02-12"), as.Date("2024-02-26"))
# generate
FR_1 <- simulateData(params_1)

#FR_1$case_true - FR_1$case_reported[,11]

# input list
params_2 <- list(
  data = list(
    alpha_lamb = alpha_lamb,  
    beta_lamb  = beta_lamb,
    n_obs       = n_obs,
    date_start = as.Date("2024-01-01"),
    seed       = seed
  ),
  reporting = list(
    D           = D,     
    D_complete        = D_complete,    
    if_fully_reported = if_fully_reported
  ),
  q_model = list(
    method        = method,
    method_params = list(alpha = alpha_ou, mu = mu_ou, 
                         b_init = b_init, sigma_ou = sigma_ou_2)
  )
)

FR_2 <- simulateData(params_2)

# input list
params_3 <- list(
  data = list(
    alpha_lamb = alpha_lamb,  
    beta_lamb  = beta_lamb,
    n_obs       = n_obs,
    date_start = as.Date("2024-01-01"),
    seed       = seed
  ),
  reporting = list(
    D           = D,     
    D_complete        = D_complete,    
    if_fully_reported = if_fully_reported
  ),
  q_model = list(
    method        = method,
    method_params = list(alpha = alpha_ou, mu = mu_ou, 
                         b_init = b_init, sigma_ou = sigma_ou_3)
  )
)

FR_3 <- simulateData(params_3)
# sum(abs(FR_3$b_t - FR_2$b_t))
# 
# sum(abs(FR_3$b_t - FR_1$b_t))

# exploritary analysis
page_num <- ceiling(nrow(FR_1$case_reported)/16)
exp_plot_1 <- fit_exp_plot(FR_1$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

print(exp_plot_1)

## $plots
## $plots[[1]]

## 
## $plots[[2]]

## 
## $plots[[3]]

## 
## $plots[[4]]

## 
## 
## $coefficients
##  [1] 0.5094860 0.9049538 0.3614813 0.5509689 0.9127422 0.7386377 0.6198705
##  [8] 0.7541731 0.7013846 0.6348717 0.6727156 0.6183231 0.6435322 0.6324601
## [15] 0.5755654 0.6097505 0.6598534 0.6553750 0.5660300 0.5911532 0.5955153
## [22] 0.5887725 0.5663633 0.5709445 0.6089811 0.5718743 0.5785093 0.6231753
## [29] 0.6214669 0.6102097 0.6554722 0.6276211 0.6368852 0.5947008 0.6365734
## [36] 0.6301158 0.6835527 0.6321464 0.6346668 0.6468446 0.6294344 0.6382356
## [43] 0.6359995 0.5874490 0.6855843 0.6101858 0.5832661 0.6212119 0.6359681
## [50] 0.6216532 0.6537254 0.5768692 0.6453913 0.5855169 0.5453848 0.5965395
## [57] 0.6140061 1.0517862 0.7159854 0.8311176

exp_b_data_1<- data.frame( date = as.Date(rownames(FR_1$case_reported)),
                          b = exp_plot_1$coefficients)
exp_b_data_1

##          date         b
## 1  2024-01-01 0.5094860
## 2  2024-01-02 0.9049538
## 3  2024-01-03 0.3614813
## 4  2024-01-04 0.5509689
## 5  2024-01-05 0.9127422
## 6  2024-01-06 0.7386377
## 7  2024-01-07 0.6198705
## 8  2024-01-08 0.7541731
## 9  2024-01-09 0.7013846
## 10 2024-01-10 0.6348717
## 11 2024-01-11 0.6727156
## 12 2024-01-12 0.6183231
## 13 2024-01-13 0.6435322
## 14 2024-01-14 0.6324601
## 15 2024-01-15 0.5755654
## 16 2024-01-16 0.6097505
## 17 2024-01-17 0.6598534
## 18 2024-01-18 0.6553750
## 19 2024-01-19 0.5660300
## 20 2024-01-20 0.5911532
## 21 2024-01-21 0.5955153
## 22 2024-01-22 0.5887725
## 23 2024-01-23 0.5663633
## 24 2024-01-24 0.5709445
## 25 2024-01-25 0.6089811
## 26 2024-01-26 0.5718743
## 27 2024-01-27 0.5785093
## 28 2024-01-28 0.6231753
## 29 2024-01-29 0.6214669
## 30 2024-01-30 0.6102097
## 31 2024-01-31 0.6554722
## 32 2024-02-01 0.6276211
## 33 2024-02-02 0.6368852
## 34 2024-02-03 0.5947008
## 35 2024-02-04 0.6365734
## 36 2024-02-05 0.6301158
## 37 2024-02-06 0.6835527
## 38 2024-02-07 0.6321464
## 39 2024-02-08 0.6346668
## 40 2024-02-09 0.6468446
## 41 2024-02-10 0.6294344
## 42 2024-02-11 0.6382356
## 43 2024-02-12 0.6359995
## 44 2024-02-13 0.5874490
## 45 2024-02-14 0.6855843
## 46 2024-02-15 0.6101858
## 47 2024-02-16 0.5832661
## 48 2024-02-17 0.6212119
## 49 2024-02-18 0.6359681
## 50 2024-02-19 0.6216532
## 51 2024-02-20 0.6537254
## 52 2024-02-21 0.5768692
## 53 2024-02-22 0.6453913
## 54 2024-02-23 0.5855169
## 55 2024-02-24 0.5453848
## 56 2024-02-25 0.5965395
## 57 2024-02-26 0.6140061
## 58 2024-02-27 1.0517862
## 59 2024-02-28 0.7159854
## 60 2024-02-29 0.8311176

exp_b_plot_1 <- ggplot(exp_b_data_1, aes(x = date, y = b)) +
  geom_point(color = "black", size = 1.5) +       
  geom_smooth(method = "loess", se = TRUE,        
              color = "blue", fill = "grey", alpha = 0.5) +
  theme_minimal() +
  labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")

print(exp_b_plot_1)

## `geom_smooth()` using formula = 'y ~ x'

# exploritary analysis
exp_plot_2 <- fit_exp_plot(FR_2$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)
print(exp_plot_2)

## $plots
## $plots[[1]]

## 
## $plots[[2]]

## 
## $plots[[3]]

## 
## $plots[[4]]

## 
## 
## $coefficients
##  [1] 0.5094860 0.8037563 0.2910791 0.7072511 1.0965872 0.9069701 0.9970528
##  [8] 0.9808200 0.6824005 0.5113808 0.5008146 0.8140539 0.7566498 0.8133688
## [15] 0.7694141 0.5905502 0.9348122 0.8371577 0.4670470 0.6298758 0.5301967
## [22] 0.4144826 0.4711797 0.3753649 0.3735918 0.3821407 0.2767169 0.5146062
## [29] 0.5711693 0.4093344 0.7423087 0.7529838 0.6356760 0.7938781 0.8968103
## [36] 0.9238802 1.0246046 0.9257366 0.7839568 0.6606546 0.5577435 0.5190049
## [43] 0.5297231 0.3532039 0.9478475 1.0628467 0.5774049 0.5455050 0.4937931
## [50] 0.6155804 0.7750446 0.6482939 0.6360851 0.5058848 0.8266197 0.7357516
## [57] 1.1599224 0.5859444 0.7163161 0.7682845

exp_b_data_2<- data.frame( date = as.Date(rownames(FR_2$case_reported)),
                          b = exp_plot_2$coefficients)
exp_b_data_2

##          date         b
## 1  2024-01-01 0.5094860
## 2  2024-01-02 0.8037563
## 3  2024-01-03 0.2910791
## 4  2024-01-04 0.7072511
## 5  2024-01-05 1.0965872
## 6  2024-01-06 0.9069701
## 7  2024-01-07 0.9970528
## 8  2024-01-08 0.9808200
## 9  2024-01-09 0.6824005
## 10 2024-01-10 0.5113808
## 11 2024-01-11 0.5008146
## 12 2024-01-12 0.8140539
## 13 2024-01-13 0.7566498
## 14 2024-01-14 0.8133688
## 15 2024-01-15 0.7694141
## 16 2024-01-16 0.5905502
## 17 2024-01-17 0.9348122
## 18 2024-01-18 0.8371577
## 19 2024-01-19 0.4670470
## 20 2024-01-20 0.6298758
## 21 2024-01-21 0.5301967
## 22 2024-01-22 0.4144826
## 23 2024-01-23 0.4711797
## 24 2024-01-24 0.3753649
## 25 2024-01-25 0.3735918
## 26 2024-01-26 0.3821407
## 27 2024-01-27 0.2767169
## 28 2024-01-28 0.5146062
## 29 2024-01-29 0.5711693
## 30 2024-01-30 0.4093344
## 31 2024-01-31 0.7423087
## 32 2024-02-01 0.7529838
## 33 2024-02-02 0.6356760
## 34 2024-02-03 0.7938781
## 35 2024-02-04 0.8968103
## 36 2024-02-05 0.9238802
## 37 2024-02-06 1.0246046
## 38 2024-02-07 0.9257366
## 39 2024-02-08 0.7839568
## 40 2024-02-09 0.6606546
## 41 2024-02-10 0.5577435
## 42 2024-02-11 0.5190049
## 43 2024-02-12 0.5297231
## 44 2024-02-13 0.3532039
## 45 2024-02-14 0.9478475
## 46 2024-02-15 1.0628467
## 47 2024-02-16 0.5774049
## 48 2024-02-17 0.5455050
## 49 2024-02-18 0.4937931
## 50 2024-02-19 0.6155804
## 51 2024-02-20 0.7750446
## 52 2024-02-21 0.6482939
## 53 2024-02-22 0.6360851
## 54 2024-02-23 0.5058848
## 55 2024-02-24 0.8266197
## 56 2024-02-25 0.7357516
## 57 2024-02-26 1.1599224
## 58 2024-02-27 0.5859444
## 59 2024-02-28 0.7163161
## 60 2024-02-29 0.7682845

exp_b_plot_2 <- ggplot(exp_b_data_2, aes(x = date, y = b)) +
  geom_point(color = "black", size = 1.5) +       
  geom_smooth(method = "loess", se = TRUE,        
              color = "blue", fill = "grey", alpha = 0.5) +
  theme_minimal() +
  labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")

print(exp_b_plot_2)

## `geom_smooth()` using formula = 'y ~ x'

# exploritary analysis
exp_plot_3 <- fit_exp_plot(FR_3$case_reported,ncol = 4, nrow = 4, page = c(1:page_num), if_fit = T)
print(exp_plot_3)

## $plots
## $plots[[1]]

## 
## $plots[[2]]

## 
## $plots[[3]]

## 
## $plots[[4]]

## 
## 
## $coefficients
##  [1] 0.5094860 0.5618074 0.2439885 1.5681553 1.2565057 0.9930251 1.7218634
##  [8] 2.0921438 0.6377368 0.2841969 0.2771032 0.9847221 1.1775413 1.1272849
## [15] 1.0413187 0.5797906 1.7766521 1.6403006 0.2278281 0.6879644 0.3979976
## [22] 0.2321269 0.2596680 0.2312933 0.2191211 0.2168676 0.2284172 0.7374936
## [29] 0.7538029 0.2531789 1.0305043 1.1162553 0.7138451 1.2997722 1.7551122
## [36] 1.7052948 1.6310699 1.5658195 1.1721399 0.7755466 0.5178290 0.2914578
## [43] 0.3120314 0.2290272 1.5879839 1.8295976 0.6404031 0.4231103 0.3184663
## [50] 0.8126387 0.6416037 0.7830538 0.7067796 0.5625519 1.3207834 1.0783707
## [57] 1.3120704 0.3799130 1.0907601 1.4468402

exp_b_data_3<- data.frame( date = as.Date(rownames(FR_3$case_reported)),
                          b = exp_plot_3$coefficients)
exp_b_data_3

##          date         b
## 1  2024-01-01 0.5094860
## 2  2024-01-02 0.5618074
## 3  2024-01-03 0.2439885
## 4  2024-01-04 1.5681553
## 5  2024-01-05 1.2565057
## 6  2024-01-06 0.9930251
## 7  2024-01-07 1.7218634
## 8  2024-01-08 2.0921438
## 9  2024-01-09 0.6377368
## 10 2024-01-10 0.2841969
## 11 2024-01-11 0.2771032
## 12 2024-01-12 0.9847221
## 13 2024-01-13 1.1775413
## 14 2024-01-14 1.1272849
## 15 2024-01-15 1.0413187
## 16 2024-01-16 0.5797906
## 17 2024-01-17 1.7766521
## 18 2024-01-18 1.6403006
## 19 2024-01-19 0.2278281
## 20 2024-01-20 0.6879644
## 21 2024-01-21 0.3979976
## 22 2024-01-22 0.2321269
## 23 2024-01-23 0.2596680
## 24 2024-01-24 0.2312933
## 25 2024-01-25 0.2191211
## 26 2024-01-26 0.2168676
## 27 2024-01-27 0.2284172
## 28 2024-01-28 0.7374936
## 29 2024-01-29 0.7538029
## 30 2024-01-30 0.2531789
## 31 2024-01-31 1.0305043
## 32 2024-02-01 1.1162553
## 33 2024-02-02 0.7138451
## 34 2024-02-03 1.2997722
## 35 2024-02-04 1.7551122
## 36 2024-02-05 1.7052948
## 37 2024-02-06 1.6310699
## 38 2024-02-07 1.5658195
## 39 2024-02-08 1.1721399
## 40 2024-02-09 0.7755466
## 41 2024-02-10 0.5178290
## 42 2024-02-11 0.2914578
## 43 2024-02-12 0.3120314
## 44 2024-02-13 0.2290272
## 45 2024-02-14 1.5879839
## 46 2024-02-15 1.8295976
## 47 2024-02-16 0.6404031
## 48 2024-02-17 0.4231103
## 49 2024-02-18 0.3184663
## 50 2024-02-19 0.8126387
## 51 2024-02-20 0.6416037
## 52 2024-02-21 0.7830538
## 53 2024-02-22 0.7067796
## 54 2024-02-23 0.5625519
## 55 2024-02-24 1.3207834
## 56 2024-02-25 1.0783707
## 57 2024-02-26 1.3120704
## 58 2024-02-27 0.3799130
## 59 2024-02-28 1.0907601
## 60 2024-02-29 1.4468402

exp_b_plot_3 <- ggplot(exp_b_data_3, aes(x = date, y = b)) +
  geom_point(color = "black", size = 1.5) +       
  geom_smooth(method = "loess", se = TRUE,        
              color = "blue", fill = "grey", alpha = 0.5) +
  theme_minimal() +
  labs(x = NULL, y = "Y", title = "Smoothed Curve of parameter b")

print(exp_b_plot_3)

## `geom_smooth()` using formula = 'y ~ x'

fit model

out_1_FR <- nowcasting_moving_window(FR_1$case_reported, scoreRange = scoreRange, 
                                case_true = FR_1$case_true,
                                start_date = as.Date("2024-01-01"),
                                D = D, sigma_b = 0.1, seeds = seed,
                                models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
                                compiled_models = compiled_models,
                                iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
                                num_chains = 3, suppress_output = T)

## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.5 seconds.
## Chain 2 finished in 1.7 seconds.
## Chain 3 finished in 1.4 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.6 seconds.
## Total execution time: 5.0 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 0.8 seconds.
## Chain 2 finished in 0.7 seconds.
## Chain 3 finished in 0.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 0.8 seconds.
## Total execution time: 2.7 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.2 seconds.
## Chain 2 finished in 9.0 seconds.
## Chain 3 finished in 6.5 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 5.9 seconds.
## Total execution time: 18.1 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 3.7 seconds.
## Chain 2 finished in 3.8 seconds.
## Chain 3 finished in 3.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 3.8 seconds.
## Total execution time: 11.7 seconds.
## 
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.3 seconds.
## Chain 2 finished in 2.3 seconds.
## Chain 3 finished in 2.2 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.3 seconds.
## Total execution time: 7.2 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.3 seconds.
## Chain 2 finished in 1.5 seconds.
## Chain 3 finished in 1.4 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.4 seconds.
## Total execution time: 4.5 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.9 seconds.
## Chain 2 finished in 2.1 seconds.
## Chain 3 finished in 17.0 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 7.0 seconds.
## Total execution time: 21.2 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 17.0 seconds.
## Chain 2 finished in 5.8 seconds.
## Chain 3 finished in 18.5 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 13.8 seconds.
## Total execution time: 41.7 seconds.
## 
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.7 seconds.
## Chain 2 finished in 2.8 seconds.
## Chain 3 finished in 3.1 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.8 seconds.
## Total execution time: 8.9 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 8.6 seconds.
## Chain 2 finished in 1.8 seconds.
## Chain 3 finished in 2.4 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 4.2 seconds.
## Total execution time: 13.0 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 3.0 seconds.
## Chain 2 finished in 27.2 seconds.
## Chain 3 finished in 41.3 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 23.8 seconds.
## Total execution time: 71.8 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 6.3 seconds.
## Chain 2 finished in 7.7 seconds.
## Chain 3 finished in 7.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 7.3 seconds.
## Total execution time: 22.1 seconds.

#save(out_1_FR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "FR_b04_sd001.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "FR_b04_sd001.RData"))

results_1_FR <- nowcasts_table(out_1_FR, D = D, report_unit = "day", 
                          models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))

results_1_FR_plots <- nowcasts_plot(results_1_FR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))

## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

out_2_FR <- nowcasting_moving_window(FR_2$case_reported, scoreRange = scoreRange, 
                                case_true = FR_2$case_true,
                                start_date = as.Date("2024-01-01"),
                                D = D, sigma_b = 0.1, seeds = seed,
                                models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
                                compiled_models = compiled_models,
                                iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
                                num_chains = 3, suppress_output = T)

## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.5 seconds.
## Chain 2 finished in 1.4 seconds.
## Chain 3 finished in 1.5 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.5 seconds.
## Total execution time: 4.9 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 0.9 seconds.
## Chain 2 finished in 1.0 seconds.
## Chain 3 finished in 0.7 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 0.8 seconds.
## Total execution time: 2.8 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 6.2 seconds.
## Chain 2 finished in 6.8 seconds.
## Chain 3 finished in 7.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 6.9 seconds.
## Total execution time: 21.1 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 5.6 seconds.
## Chain 2 finished in 5.4 seconds.
## Chain 3 finished in 5.7 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 5.6 seconds.
## Total execution time: 17.0 seconds.
## 
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.9 seconds.
## Chain 2 finished in 1.8 seconds.
## Chain 3 finished in 1.9 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.9 seconds.
## Total execution time: 5.9 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 3.2 seconds.
## Chain 2 finished in 6.0 seconds.
## Chain 3 finished in 1.1 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 3.4 seconds.
## Total execution time: 10.7 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.9 seconds.
## Chain 2 finished in 17.0 seconds.
## Chain 3 finished in 17.7 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 12.2 seconds.
## Total execution time: 36.9 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 6.3 seconds.
## Chain 2 finished in 6.9 seconds.
## Chain 3 finished in 7.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 7.0 seconds.
## Total execution time: 21.4 seconds.
## 
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.7 seconds.
## Chain 2 finished in 2.7 seconds.
## Chain 3 finished in 2.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.7 seconds.
## Total execution time: 8.4 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.2 seconds.
## Chain 2 finished in 1.9 seconds.
## Chain 3 finished in 13.2 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 5.8 seconds.
## Total execution time: 17.6 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 45.8 seconds.
## Chain 2 finished in 47.4 seconds.
## Chain 3 finished in 44.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 46.0 seconds.
## Total execution time: 138.3 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 8.7 seconds.
## Chain 2 finished in 8.6 seconds.
## Chain 3 finished in 8.4 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 8.6 seconds.
## Total execution time: 26.0 seconds.

#save(out_2_FR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "FR_b04_sd01.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "FR_b04_sd01.RData"))

results_2_FR <- nowcasts_table(out_2_FR, D = D, report_unit = "day", 
                          models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))

results_2_FR_plots <- nowcasts_plot(results_2_FR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))

out_3_FR <- nowcasting_moving_window(FR_3$case_reported, scoreRange = scoreRange, 
                                case_true = FR_3$case_true,
                                start_date = as.Date("2024-01-01"),
                                D = D, sigma_b = 0.1, seeds = seed,
                                models_to_run =c("fixed_q", "fixed_b", "linear_b", "ou_b"),
                                compiled_models = compiled_models,
                                iter_sampling = 2000, iter_warmup = 1000, refresh = 0,
                                num_chains = 3, suppress_output = T)

## ====================
## now=2024-01-29 (1/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.7 seconds.
## Chain 2 finished in 1.7 seconds.
## Chain 3 finished in 1.7 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.7 seconds.
## Total execution time: 5.4 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 3.7 seconds.
## Chain 2 finished in 7.2 seconds.
## Chain 3 finished in 1.3 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 4.1 seconds.
## Total execution time: 12.5 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 8.1 seconds.
## Chain 2 finished in 1.2 seconds.
## Chain 3 finished in 7.6 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 5.7 seconds.
## Total execution time: 17.3 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 12.6 seconds.
## Chain 2 finished in 13.1 seconds.
## Chain 3 finished in 12.8 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 12.8 seconds.
## Total execution time: 38.8 seconds.
## 
## ====================
## now=2024-02-12 (2/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.0 seconds.
## Chain 2 finished in 2.0 seconds.
## Chain 3 finished in 2.1 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.0 seconds.
## Total execution time: 6.3 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 1.5 seconds.
## Chain 2 finished in 1.2 seconds.
## Chain 3 finished in 1.6 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 1.4 seconds.
## Total execution time: 4.6 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.7 seconds.
## Chain 2 finished in 2.1 seconds.
## Chain 3 finished in 1.6 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.1 seconds.
## Total execution time: 6.7 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 19.8 seconds.
## Chain 2 finished in 19.7 seconds.
## Chain 3 finished in 18.2 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 19.3 seconds.
## Total execution time: 58.0 seconds.
## 
## ====================
## now=2024-02-26 (3/3)
## ====================
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 4.8 seconds.
## Chain 2 finished in 2.7 seconds.
## Chain 3 finished in 2.7 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 3.4 seconds.
## Total execution time: 10.5 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 2.3 seconds.
## Chain 2 finished in 2.8 seconds.
## Chain 3 finished in 1.2 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 2.1 seconds.
## Total execution time: 6.6 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 49.9 seconds.
## Chain 2 finished in 48.8 seconds.
## Chain 3 finished in 43.3 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 47.3 seconds.
## Total execution time: 142.4 seconds.
## 
## Running MCMC with 3 sequential chains...
## 
## Chain 1 finished in 30.2 seconds.
## Chain 2 finished in 27.2 seconds.
## Chain 3 finished in 28.1 seconds.
## 
## All 3 chains finished successfully.
## Mean chain execution time: 28.5 seconds.
## Total execution time: 85.7 seconds.

#save(out_3_FR, file = file.path(path_proj, "data", "fitted_model", "simulation_ou", "FR_b04_sd03.RData"))
#load(file.path(path_proj,"data", "fitted_model", "simulation", "FR_b04_sd03.RData"))

results_3_FR <- nowcasts_table(out_3_FR, D = D, report_unit = "day", 
                          models_to_run = c("fixed_q", "fixed_b", "linear_b", "ou_b"))

results_3_FR_plots <- nowcasts_plot(results_3_FR, D = D, report_unit = "day", models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"))

check results

results_1_FR_plots

## [[1]]

## 
## [[2]]

## 
## [[3]]

# all cases
for(i in 1:length(results_1_FR)){
  print(calculate_metrics(results_1_FR[[i]]))
}

##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1  20.41   3.08  11.32   2.27         104.87          1.00  fixed_q
## 2 760.92  97.78 605.54  97.67           7.00          0.00  fixed_b
## 3 395.13 802.13 319.18 369.60         425.21          0.55 linear_b
## 4  19.49   3.00  10.73   2.26         117.87          1.00     ou_b
##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1  12.23   2.36   8.94   1.66         114.63          1.00  fixed_q
## 2 934.21  98.48 798.56  98.42           7.19          0.00  fixed_b
## 3 264.51 404.24 235.18 166.50         412.36          0.42 linear_b
## 4  16.53   2.71  12.95   2.15         118.00          1.00     ou_b
##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1   7.60   7.23   5.67   2.34          99.99          1.00  fixed_q
## 2 836.45  98.68 685.81  98.63           6.39          0.00  fixed_b
## 3 234.76 600.91 188.71 201.51         324.59          0.33 linear_b
## 4  11.99   7.44   9.37   2.86         101.93          1.00     ou_b

# Within D
for(i in 1:length(results_1_FR)){
  print(calculate_metrics(data.table::last(results_1_FR[[i]], D)))
}

##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1   34.10  2.58   25.59  2.02         178.41             1  fixed_q
## 2 1164.92 99.87 1153.16 99.87           5.60             0  fixed_b
## 3  514.41 40.20  455.50 37.45         116.00             0 linear_b
## 4   32.12  2.39   22.27  1.79         215.21             1     ou_b
##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1   20.69  1.97   18.64  1.76         164.80             1  fixed_q
## 2 1126.89 99.79 1111.35 99.79           7.50             0  fixed_b
## 3  382.67 38.81  372.57 35.86         117.10             0 linear_b
## 4   26.20  2.47   24.99  2.32         174.01             1     ou_b
##     RMSE RMSPE    MAE  MAPE Interval_Width Coverage_Rate   Method
## 1   4.86 16.62   3.84  7.13           63.5           1.0  fixed_q
## 2 270.03 98.30 225.62 98.27            6.7           0.0  fixed_b
## 3  67.86 35.92  61.22 34.07           50.0           0.1 linear_b
## 4   6.17 16.91   5.25  7.54           65.1           1.0     ou_b

sigma_rw = 0.1

results_2_FR_plots

## [[1]]

## 
## [[2]]

## 
## [[3]]

# all cases
for(i in 1:length(results_2_FR)){
  print(calculate_metrics(results_2_FR[[i]]))
}

##     RMSE   RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1 135.69   12.49  68.59   8.49          97.76          0.76  fixed_q
## 2 753.03   97.72 599.58  97.62           7.28          0.00  fixed_b
## 3 491.54 1120.16 397.03 513.87         264.32          0.17 linear_b
## 4  54.27    5.64  25.92   3.58         232.39          1.00     ou_b
##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1  83.16   8.74  58.89   7.41         115.56          0.65  fixed_q
## 2 928.50  98.41 792.56  98.35           7.21          0.00  fixed_b
## 3 370.10 836.16 314.29 332.13         436.17          0.42 linear_b
## 4  60.66   5.87  27.09   3.31         163.77          0.91     ou_b
##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1  56.34  10.21  37.56   6.82         100.71          0.79  fixed_q
## 2 833.25  98.71 684.73  98.67           6.44          0.00  fixed_b
## 3 325.37 917.54 236.49 303.55         279.33          0.14 linear_b
## 4  53.73  13.90  22.51   5.41         117.00          0.93     ou_b

# Within D
for(i in 1:length(results_2_FR)){
  print(calculate_metrics(data.table::last(results_2_FR[[i]], D)))
}

##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  229.53 19.51  173.41 14.99         158.50           0.3  fixed_q
## 2 1140.33 99.87 1126.31 99.87           5.40           0.0  fixed_b
## 3  596.54 48.25  535.38 45.16         107.00           0.0 linear_b
## 4   91.99  7.85   66.91  5.75         543.02           1.0     ou_b
##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  136.14 11.81  122.21 10.88         166.81           0.4  fixed_q
## 2 1095.72 99.78 1081.43 99.78           7.70           0.0  fixed_b
## 3  360.45 38.67  332.31 33.55         116.50           0.0 linear_b
## 4   20.26  2.18   15.56  1.60         320.71           1.0     ou_b
##     RMSE RMSPE    MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  12.26 19.12  10.55 11.61           66.0           1.0  fixed_q
## 2 290.64 98.56 239.71 98.55            6.8           0.0  fixed_b
## 3  74.91 33.41  65.26 32.23           51.3           0.1 linear_b
## 4   9.65 30.72   7.96 15.97           90.5           1.0     ou_b

sigma_rw = 0.3

results_3_FR_plots

## [[1]]

## 
## [[2]]

## 
## [[3]]

# all cases
for(i in 1:length(results_3_FR)){
  print(calculate_metrics(results_3_FR[[i]]))
}

##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1 250.49  23.44 143.76  17.66          93.97          0.55  fixed_q
## 2 755.29  97.68 597.81  97.58           8.62          0.00  fixed_b
## 3 451.30 649.10 343.63 307.37         336.01          0.59 linear_b
## 4 232.73  25.64 113.99  14.03         450.50          0.83     ou_b
##     RMSE RMSPE    MAE  MAPE Interval_Width Coverage_Rate   Method
## 1 208.84 21.53 160.83 19.05         115.93          0.26  fixed_q
## 2 925.43 98.46 788.27 98.40           7.23          0.00  fixed_b
## 3 272.48 29.10 195.62 23.12          91.94          0.26 linear_b
## 4 388.46 35.25 178.09 18.07         291.11          0.77     ou_b
##     RMSE  RMSPE    MAE   MAPE Interval_Width Coverage_Rate   Method
## 1 134.67  20.59  98.52  15.58         100.46          0.39  fixed_q
## 2 831.91  98.62 681.50  98.57           6.47          0.00  fixed_b
## 3 339.16 877.52 246.61 296.53         274.33          0.19 linear_b
## 4 350.80  49.37 148.44  22.78         211.74          0.77     ou_b

# Within D
for(i in 1:length(results_3_FR)){
  print(calculate_metrics(data.table::last(results_3_FR[[i]], D)))
}

##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  417.27 35.52  342.36 29.61         149.10           0.2  fixed_q
## 2 1152.35 99.85 1139.46 99.85           5.70           0.0  fixed_b
## 3  687.80 56.66  638.08 53.96          97.80           0.0 linear_b
## 4  328.47 29.77  235.34 21.20        1101.94           0.8     ou_b
##      RMSE RMSPE     MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  343.00 32.54  320.99 30.06         168.11           0.1  fixed_q
## 2 1092.19 99.78 1076.81 99.78           7.70           0.0  fixed_b
## 3  366.81 41.38  294.44 31.19         115.11           0.0 linear_b
## 4  106.12 12.54   52.09  6.04         441.55           1.0     ou_b
##     RMSE RMSPE    MAE  MAPE Interval_Width Coverage_Rate   Method
## 1  31.41 35.89  25.30 23.89           64.7           0.8  fixed_q
## 2 274.88 97.97 226.52 97.93            6.8           0.0  fixed_b
## 3  79.70 29.42  64.64 28.70           49.9           0.2 linear_b
## 4  19.53 87.94  17.23 44.20          131.1           1.0     ou_b

output

results_1_FR_plots <- nowcasts_plot(results_1_FR, D = D, report_unit = "day",
                                 models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
                                 combine_plots = T, ncol = 2
                                 )

ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "FR_b04_sd001.png"), 
       plot = results_1_FR_plots, 
       width = 10, height = 12, dpi = 300)
# table
fully_tables_1 <- list();count_1 = 1
for (i in 1:length(scoreRange)) {
  fully_tables_1[[count_1]] <- calculate_metrics(results_1_FR[[i]])
  count_1 = count_1 + 1
}
cat(highlight_metrics(fully_tables_1, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
                  date_labels = as.character(scoreRange)))

## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
##  & 20.41 & 3.08 & 11.32 & 2.27 & 104.87 & \textcolor{red}{1.00} & Fixed q \\
##  & 760.92 & 97.78 & 605.54 & 97.67 & \textcolor{red}{7.00} & 0.00 & Fixed b \\
##  & 395.13 & 802.13 & 319.18 & 369.60 & 425.21 & 0.55 & Polynomial b \\
##  & \textcolor{red}{19.49} & \textcolor{red}{3.00} & \textcolor{red}{10.73} & \textcolor{red}{2.26} & 117.87 & \textcolor{red}{1.00} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
##  & \textcolor{red}{12.23} & \textcolor{red}{2.36} & \textcolor{red}{8.94} & \textcolor{red}{1.66} & 114.63 & \textcolor{red}{1.00} & Fixed q \\
##  & 934.21 & 98.48 & 798.56 & 98.42 & \textcolor{red}{7.19} & 0.00 & Fixed b \\
##  & 264.51 & 404.24 & 235.18 & 166.50 & 412.36 & 0.42 & Polynomial b \\
##  & 16.53 & 2.71 & 12.95 & 2.15 & 118.00 & \textcolor{red}{1.00} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
##  & \textcolor{red}{7.60} & \textcolor{red}{7.23} & \textcolor{red}{5.67} & \textcolor{red}{2.34} & 99.99 & \textcolor{red}{1.00} & Fixed q \\
##  & 836.45 & 98.68 & 685.81 & 98.63 & \textcolor{red}{6.39} & 0.00 & Fixed b \\
##  & 234.76 & 600.91 & 188.71 & 201.51 & 324.59 & 0.33 & Polynomial b \\
##  & 11.99 & 7.44 & 9.37 & 2.86 & 101.93 & \textcolor{red}{1.00} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}

output

results_2_FR_plots <- nowcasts_plot(results_2_FR, D = D, report_unit = "day",
                                 models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
                                 combine_plots = T, ncol = 2
                                 )

ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "FR_b04_sd01.png"), 
       plot = results_2_FR_plots, 
       width = 10, height = 12, dpi = 300)
# table
fully_tables_2 <- list();count_2 = 1
for (i in 1:length(scoreRange)) {
  fully_tables_2[[count_2]] <- calculate_metrics(results_2_FR[[i]])
  count_2 = count_2 + 1
}
cat(highlight_metrics(fully_tables_2, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
                  date_labels = as.character(scoreRange)))

## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
##  & 135.69 & 12.49 & 68.59 & 8.49 & 97.76 & 0.76 & Fixed q \\
##  & 753.03 & 97.72 & 599.58 & 97.62 & \textcolor{red}{7.28} & 0.00 & Fixed b \\
##  & 491.54 & 1120.16 & 397.03 & 513.87 & 264.32 & 0.17 & Polynomial b \\
##  & \textcolor{red}{54.27} & \textcolor{red}{5.64} & \textcolor{red}{25.92} & \textcolor{red}{3.58} & 232.39 & \textcolor{red}{1.00} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
##  & 83.16 & 8.74 & 58.89 & 7.41 & 115.56 & 0.65 & Fixed q \\
##  & 928.50 & 98.41 & 792.56 & 98.35 & \textcolor{red}{7.21} & 0.00 & Fixed b \\
##  & 370.10 & 836.16 & 314.29 & 332.13 & 436.17 & 0.42 & Polynomial b \\
##  & \textcolor{red}{60.66} & \textcolor{red}{5.87} & \textcolor{red}{27.09} & \textcolor{red}{3.31} & 163.77 & \textcolor{red}{0.91} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
##  & 56.34 & \textcolor{red}{10.21} & 37.56 & 6.82 & 100.71 & 0.79 & Fixed q \\
##  & 833.25 & 98.71 & 684.73 & 98.67 & \textcolor{red}{6.44} & 0.00 & Fixed b \\
##  & 325.37 & 917.54 & 236.49 & 303.55 & 279.33 & 0.14 & Polynomial b \\
##  & \textcolor{red}{53.73} & 13.90 & \textcolor{red}{22.51} & \textcolor{red}{5.41} & 117.00 & \textcolor{red}{0.93} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}

results_3_FR_plots <- nowcasts_plot(results_3_FR, D = D, report_unit = "day",
                                 models_to_run = c("fixed_q", "fixed_b", "linear_b" , "ou_b"),
                                 combine_plots = T, ncol = 2
                                 )

ggsave(filename = file.path(path_proj, "plots_to_show", "simulation", "FR_b04_sd03.png"), 
       plot = results_3_FR_plots, 
       width = 10, height = 12, dpi = 300)
# table
fully_tables_3 <- list();count_3 = 1
for (i in 1:length(scoreRange)) {
  fully_tables_3[[count_3]] <- calculate_metrics(results_3_FR[[i]])
  count_3 = count_3 + 1
}
cat(highlight_metrics(fully_tables_3, method_names =c("Fixed q", "Fixed b", "Polynomial b" , "Random Walk b"),
                  date_labels = as.character(scoreRange)))

## \begin{table}[htbp]
## \centering
## \caption{Metrics Comparison}
## \begin{tabular}{c|c|c|c|c|c|c|c}
## \hline
## Scenario & RMSE & RMSPE & MAE & MAPE & Interval Width & Coverage Rate & Method \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-01-29}} \\
## \hline
##  & 250.49 & \textcolor{red}{23.44} & 143.76 & 17.66 & 93.97 & 0.55 & Fixed q \\
##  & 755.29 & 97.68 & 597.81 & 97.58 & \textcolor{red}{8.62} & 0.00 & Fixed b \\
##  & 451.30 & 649.10 & 343.63 & 307.37 & 336.01 & 0.59 & Polynomial b \\
##  & \textcolor{red}{232.73} & 25.64 & \textcolor{red}{113.99} & \textcolor{red}{14.03} & 450.50 & \textcolor{red}{0.83} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-12}} \\
## \hline
##  & \textcolor{red}{208.84} & \textcolor{red}{21.53} & \textcolor{red}{160.83} & 19.05 & 115.93 & 0.26 & Fixed q \\
##  & 925.43 & 98.46 & 788.27 & 98.40 & \textcolor{red}{7.23} & 0.00 & Fixed b \\
##  & 272.48 & 29.10 & 195.62 & 23.12 & 91.94 & 0.26 & Polynomial b \\
##  & 388.46 & 35.25 & 178.09 & \textcolor{red}{18.07} & 291.11 & \textcolor{red}{0.77} & Random Walk b \\
## \hline
## \multicolumn{8}{l}{\textbf{Now is 2024-02-26}} \\
## \hline
##  & \textcolor{red}{134.67} & \textcolor{red}{20.59} & \textcolor{red}{98.52} & \textcolor{red}{15.58} & 100.46 & 0.39 & Fixed q \\
##  & 831.91 & 98.62 & 681.50 & 98.57 & \textcolor{red}{6.47} & 0.00 & Fixed b \\
##  & 339.16 & 877.52 & 246.61 & 296.53 & 274.33 & 0.19 & Polynomial b \\
##  & 350.80 & 49.37 & 148.44 & 22.78 & 211.74 & \textcolor{red}{0.77} & Random Walk b \\
## \hline
## \end{tabular}
## \end{table}